home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / sdimage.com / SDITEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-02-14  |  3.4 KB  |  132 lines
  1.  
  2. {a quick little demo program to show the use of SDImage and ExpBox}
  3. {written by Michael Day 14 february 1989}
  4. {released to the public domain}
  5.  
  6. program sditest;
  7.  
  8. uses crt,graph,sdimage,expbox;
  9.  
  10. const
  11.     xSpeed   : word = 50;  {explosion speed}
  12.     xStep    : byte = 5;    {explosion count}
  13.     xStyle   : byte = 0;    {explosion style}
  14.     xSound   : byte = $10;  {explosion sound}
  15.     xRect    : byte = $80;  {explosion rectangles}
  16.     xColor   : byte = blue; {explosion color}
  17.     xPattern : byte = solidfill; {explosion pattern}
  18.     xrColor  : byte = yellow; {explosion rectangle}
  19.  
  20. var
  21.     gr,gd:integer;
  22.     ch : char;
  23.     IT,IE:integer;
  24.     x1,y1,x2,y2:integer;
  25.     StyleIt : integer;
  26.  
  27. function fstr(I:integer):string;  {functionalized Str procedure}
  28. var S:string[8];
  29. begin
  30.   str(I,S);
  31.   fstr := S;
  32. end;
  33.  
  34. procedure bomb(I:integer);  {rats! show what went wrong}
  35. begin
  36.   setfillstyle(solidfill,black);
  37.   bar(0,0,100,10);
  38.   setcolor(green);
  39.   moveto(0,0);
  40.   outtext('OOPS!:'+fstr(i)+':'+fstr(ImageError));
  41.   Halt;
  42. end;
  43.  
  44. procedure ShowStr(S:string);   {display a string clipped to window edge}
  45. var x,y:integer;
  46. begin
  47.   y := y1+4;
  48.   while y < (succ(y2)-TextHeight('X')) do
  49.   begin
  50.     x := x1+4;
  51.     while x < x2 do
  52.     begin
  53.       moveto(x,y);
  54.       outtext(copy(S,1, pred(x2 div TextWidth('X')) - (x div TextWidth('X'))));
  55.       x := x + (length(S)*TextWidth('X'))+TextWidth('X');
  56.     end;
  57.     y := y + TextHeight('X');
  58.   end;
  59. end;
  60.  
  61.  
  62. {--------------------------------------------}
  63. {here is where it all begins}
  64.  
  65. begin
  66.   gr := 0;
  67.   gd := 0;
  68.   initgraph(gr,gd,'');
  69.  
  70.  {  to direct the image to a ram disk, put your path in here }
  71. {  if not SetImagePath('F:\SDI') then bomb(4); }
  72.  
  73.   x1 := 20;            {defines the image area we will be using}
  74.   y1 := 20;
  75.   x2 := 620;
  76.   y2 := 180;
  77.  
  78.   {this allows you to change the buffer size}
  79.   {if you want to see how it affects things}
  80. { if not AllocImageBuf(1,1000) then Bomb(3); }
  81.  
  82.   moveto(1,1);
  83.   outtext('The following special effects are available:');
  84.   for IT := 0 to 7 do       {create the images}
  85.   begin
  86.     setfillstyle(solidfill,black);
  87.     bar(x1,y1,x2,y2);
  88.     setColor(white);
  89.     case IT of
  90.       0:ShowStr('Pull Down (Vertical)');
  91.       1:ShowStr('Pull Up (Vertical)');
  92.       2:ShowStr('Pull Right (Horizontal)');
  93.       3:ShowStr('Pull Left (Horizontal)');
  94.       4:ShowStr('Merge Vertical');
  95.       5:ShowStr('Expand Vertical');
  96.       6:ShowStr('Merge Horizontal');
  97.       7:ShowStr('Expand Horizontal');
  98.     end;
  99.     StyleIt := IT or $10; {<- $10 means use compression}
  100.     if not saveImage(IT,1, x1,y1,x2,y2, StyleIT) then bomb(1);
  101.     setfillstyle(solidfill,black);
  102.     bar(x1,y1,x2,y2);
  103.   end;
  104.  
  105.   setfillstyle(solidfill,black); {now clear the dispay}
  106.   bar(0,0,GetMaxX,GetMaxY);
  107.   setColor(white);
  108.  
  109.   IT := 0;    {now we show all the great stuff we can do}
  110.   IE := 0;
  111. repeat
  112.   xStyle := ie or xRect {or xSound};
  113.   ExplodeBox(x1-10,y1-10,x2+10,y2+10,
  114.              xSpeed,xStep,xStyle,
  115.              xColor,xPattern,xrColor);
  116.  
  117.   if not displayImage(IT,1, false) then bomb(2);
  118.   delay(1000);
  119.   inc(IT);
  120.   if IT > 7 then IT := 0;
  121.   Inc(IE);
  122.   if IE > 8 then IE := 0;
  123.  
  124.   setfillstyle(solidfill,black);  {clear the display between images}
  125.   bar(0,0,GetMaxX,GetMaxY);
  126.   setColor(white);
  127.   ch := #255;
  128.   if keypressed then ch := readkey;  {stop when they tell us to}
  129. until ch < #32;
  130.  
  131. end.
  132.